;;;; culling.lisp
;;;;
;;;; Doing a culler in lisp
;;;;

(in-package :dreaming-tree)


(defmethod update-frustum ((cull basic-culler))
  (setf (culling-frustum cull) (compute-frustum (culling-camera cull))))

(defmethod print-culler-frustum-details ((c basic-culler) &optional (stream t))
  (iter (for p in (culling-frustum c))
	(print-plane-details p stream)
	(terpri)))


;; Build, determine, calculate - could you get your semantics
;; straight for once!  You might have a future counting angels on
;; pinheads, though.
(defun partition-if (pred list)
  "Return 2 values: elements of list that satisfy pred,
  and elements that don't."
  (let ((yes-list nil)
        (no-list nil))
    (dolist (item list)
      (if (funcall pred item)
          (push item yes-list)
          (push item no-list)))
    (values (nreverse yes-list) (nreverse no-list))))

(defun %determine-visible-set (culler root) ;; Was (root r-tree)
  (labels ((build-visible-set (r)
	     (let ((vset (iter (for c in (children r))
			       (when (visible-p culler c)
				 (collect c)))))
	       (multiple-value-bind (nodes leaves) (partition-if #'(lambda (x)
								     (typep x 'node))
								 (if (listp vset)
								     vset
								     (list vset)))
		 (append leaves
			 (alexandria:flatten (iter (for n in nodes)
						   (collecting (build-visible-set n)))))))))
    (when (visible-p culler root)
      (nreverse (build-visible-set root)))))

(defun %determine-visible-set-2 (culler obj)
  (if (visible-p culler obj)
      (list obj)))

;;; === Culling Bounding Sphere ===

(defmethod distance ((bs bsphere) (plane plane))
  (let* ((d (distance (center bs) plane))
	 (r (radius bs)))
    (if (<= d r)
	0.0
	(- d r))))

(defmethod which-side ((bs bsphere) plane)
  ;(format t "~A ~A ~A~%" (center bs) (plane-normal plane) (which-side (center bs) plane))
  (if (< (distance bs plane) +epsilon+)
      0
      (which-side (center bs) plane)))

(defmethod visible-p ((cull basic-culler) (bs bsphere))
  (with-slots (planes states) cull
    (iter (for elem in (map 'list #'(lambda (p s)
				      (if s
					  (which-side bs p)
					  1))
			    planes states))
	  (never (< elem 0.0)))))

(defmethod visible-p ((cull basic-culler) (s spatial))
  (visible-p cull (bounding-volume s)))

;;; === Testing helpers ===

(defparameter node nil)
(defparameter c1 nil)
(defparameter c2 nil)
(defparameter c3 nil)
(defparameter cull nil)

(defun setup-culling-test (view)
  (setf (renderer-scene-root view) (cube-scene))
  (setf cull (make-instance 'basic-culler :camera (camera view)))
  (setf node (renderer-scene-root view))
  (setf c1 (first (children node))
	c2 (second (children node))
	c3 (third (children node)))
  (update-frustum cull))

(defun check-visible (cull)
  (update-frustum cull)
  (setf (culling-planes cull) (culling-frustum cull)
	(culling-plane-states cull) '(t t t t t t))
  (format t "~A:~A  ~A:~A  ~A:~A~%" (center (world-bound c1)) (visible-p cull c1)
	  (center (world-bound c2)) (visible-p cull c2)
	  (center (world-bound c3)) (visible-p cull c3)))
